In this report, we reproduce the analyses in the fMRI study 1.
First, we load the relevant packages, define functions and plotting aesthetics, and load and tidy the data.
library(pacman)
pacman::p_load(tidyverse, purrr, fs, knitr, lmerTest, ggeffects, kableExtra, boot, devtools, install = TRUE)
devtools::install_github("hadley/emo")source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")
# MLM results table function
table_model = function(model_data, print = TRUE) {
table = model_data %>%
broom.mixed::tidy(conf.int = TRUE) %>%
filter(effect == "fixed") %>%
rename("SE" = std.error,
"t" = statistic,
"p" = p.value) %>%
select(-group, -effect) %>%
mutate_at(vars(-contains("term"), -contains("p")), round, 2) %>%
mutate(term = gsub("cond", "", term),
term = gsub("\\(Intercept\\)", "intercept", term),
term = gsub("condother", "other", term),
term = gsub("condself", "self", term),
term = gsub("siteUSA", "sample (USA)", term),
term = gsub("self_referential", "self-referential", term),
term = gsub("self_relevance_z", "self-relevance", term),
term = gsub("social_relevance_z", "social relevance", term),
term = gsub(":", " x ", term),
p = ifelse(p < .001, "< .001",
ifelse(p > .999, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
`b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
select(term, `b [95% CI]`, df, t, p)
if (isTRUE(print)) {
table %>%
kable() %>%
kableExtra::kable_styling()
} else {
table
}
}
simple_slopes = function(model, var, moderator, continuous = TRUE) {
if (isTRUE(continuous)) {
emmeans::emtrends(model, as.formula(paste("~", moderator)), var = var) %>%
data.frame() %>%
rename("trend" = 2) %>%
mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", trend, asymp.LCL, asymp.UCL)) %>%
select(!!moderator, `b [95% CI]`) %>%
kable() %>%
kableExtra::kable_styling()
} else {
confint(emmeans::contrast(emmeans::emmeans(model, as.formula(paste("~", var, "|", moderator))), "revpairwise", by = moderator, adjust = "none")) %>%
data.frame() %>%
filter(grepl("control", contrast)) %>%
mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", estimate, asymp.LCL, asymp.UCL)) %>%
select(contrast, !!moderator, `b [95% CI]`) %>%
arrange(contrast) %>%
kable() %>%
kableExtra::kable_styling()
}
}palette_condition = c("self" = "#ee9b00",
"control" = "#bb3e03",
"other" = "#005f73")
palette_roi = c("self-referential" = "#ee9b00",
"mentalizing" = "#005f73")
palette_dv = c("self-relevance" = "#ee9b00",
"social relevance" = "#005f73",
"sharing" = "#56282D")
palette_sample = c("Netherlands" = "#027EA1",
"USA" = "#334456")
plot_aes = theme_minimal() +
theme(legend.position = "top",
legend.text = element_text(size = 12),
text = element_text(size = 16, family = "Futura Medium"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text = element_text(color = "black"),
axis.line = element_line(colour = "black"),
axis.ticks.y = element_blank())merged_all = read.csv("../data/study1_data.csv")
ratings_z = merged_all %>%
select(pID, event, trial, self_relevance, social_relevance) %>%
unique() %>%
mutate(self_relevance_z = scale(self_relevance, center = TRUE, scale = TRUE),
social_relevance_z = scale(social_relevance, center = TRUE, scale = TRUE))
merged = merged_all %>%
filter(outlier == "no" | is.na(outlier)) %>%
filter(atlas %in% c("self-referential", "mentalizing")) %>%
group_by(pID, atlas) %>%
mutate(parameter_estimate_std = parameter_estimate / sd(parameter_estimate, na.rm = TRUE)) %>%
left_join(., ratings_z)
merged_wide = merged %>%
select(pID, site, trial, cond, value, self_relevance, self_relevance_z, social_relevance, social_relevance_z, atlas, parameter_estimate_std) %>%
spread(atlas, parameter_estimate_std) %>%
rename("self_referential" = `self-referential`)Check the data quality and identify missing data
merged_wide %>%
select(pID, site) %>%
group_by(site) %>%
unique() %>%
summarize(n = n()) %>%
arrange(n) %>%
rename("sample" = site) %>%
kable(digits = 2) %>%
kableExtra::kable_styling()| sample | n |
|---|---|
| Netherlands | 40 |
| USA | 45 |
Print participant IDs who have < 72 trials
merged_wide %>%
group_by(pID) %>%
summarize(n = n()) %>%
filter(n < 72) %>%
arrange(n) %>%
kable(digits = 2) %>%
kableExtra::kable_styling()| pID | n |
|---|---|
| BPP65 | 59 |
| BPA34 | 62 |
| BPP52 | 62 |
| BPA23 | 63 |
| BPP21 | 63 |
| BPP05 | 66 |
| BPA45 | 67 |
| BPP61 | 67 |
| BPA29 | 68 |
| BPA47 | 68 |
| BPP64 | 68 |
| BPA04 | 69 |
| BPP56 | 69 |
| BPA12 | 70 |
| BPP20 | 70 |
| BPP58 | 70 |
| BPA02 | 71 |
| BPA05 | 71 |
| BPA08 | 71 |
| BPA16 | 71 |
| BPA26 | 71 |
| BPA27 | 71 |
| BPA31 | 71 |
| BPA32 | 71 |
| BPA33 | 71 |
| BPA35 | 71 |
| BPA37 | 71 |
| BPA38 | 71 |
| BPA46 | 71 |
| BPP22 | 71 |
| BPP67 | 71 |
Print participant IDs who have > 0 missing responses
merged_wide %>%
filter(is.na(value)) %>%
group_by(pID) %>%
summarize(n = n()) %>%
arrange(-n) %>%
kable(digits = 2) %>%
kableExtra::kable_styling()| pID | n |
|---|---|
| BPA10 | 12 |
| BPA35 | 12 |
| BPP21 | 10 |
| BPA45 | 9 |
| BPA12 | 8 |
| BPA33 | 4 |
| BPP60 | 3 |
| BPP20 | 2 |
| BPP26 | 2 |
| BPP56 | 2 |
| BPP66 | 2 |
| BPA02 | 1 |
| BPA03 | 1 |
| BPA04 | 1 |
| BPA08 | 1 |
| BPA27 | 1 |
| BPA32 | 1 |
| BPP12 | 1 |
| BPP15 | 1 |
| BPP29 | 1 |
| BPP33 | 1 |
| BPP47 | 1 |
| BPP49 | 1 |
| BPP65 | 1 |
These plots are before outliers were excluded
merged_all %>%
ggplot(aes("", global_mean, fill = cond)) +
geom_flat_violin(position = position_nudge(x = .15, y = 0), color = FALSE, alpha = .5) +
coord_flip() +
geom_point(aes(color = cond), position = position_jitter(width = .05), size = .1, alpha = .2) +
geom_boxplot(width = .1, outlier.shape = NA, color = "black", position = position_dodge(.15)) +
scale_fill_manual(values = palette_condition) +
scale_color_manual(values = palette_condition) +
scale_x_discrete(expand = c(0, .1)) +
labs(x = "") +
plot_aesmerged_all %>%
group_by(pID, cond) %>%
summarize(global_mean = mean(global_mean, na.rm = TRUE)) %>%
ggplot(aes("", global_mean, fill = cond)) +
geom_flat_violin(position = position_nudge(x = .15, y = 0), color = FALSE, alpha = .5) +
coord_flip() +
geom_point(aes(color = cond), position = position_jitter(width = .05), size = 1, alpha = .5) +
geom_boxplot(width = .1, outlier.shape = NA, color = "black", position = position_dodge(.15)) +
scale_fill_manual(values = palette_condition) +
scale_color_manual(values = palette_condition) +
scale_x_discrete(expand = c(0, .1)) +
labs(x = "") +
plot_aesmerged_all %>%
group_by(outlier) %>%
summarize(n = n()) %>%
spread(outlier, n) %>%
mutate(percent = round((yes / (yes + no)) * 100, 1))Summarize means, SDs, and correlations between the ROIs
merged_wide %>%
gather(variable, value, value, self_relevance, social_relevance) %>%
group_by(variable) %>%
summarize(M = mean(value, na.rm = TRUE),
SD = sd(value, na.rm = TRUE)) %>%
mutate(variable = ifelse(variable == "self_relevance", "self-relevance",
ifelse(variable == "social_relevance", "social relevance", "sharing intention"))) %>%
kable(digits = 2) %>%
kableExtra::kable_styling()| variable | M | SD |
|---|---|---|
| self-relevance | 2.57 | 1.02 |
| social relevance | 2.67 | 0.96 |
| sharing intention | 2.62 | 1.02 |
merged_wide %>%
gather(variable, value, mentalizing, self_referential) %>%
group_by(variable) %>%
summarize(M = mean(value, na.rm = TRUE),
SD = sd(value, na.rm = TRUE)) %>%
kable(digits = 2) %>%
kableExtra::kable_styling()| variable | M | SD |
|---|---|---|
| mentalizing | 0.37 | 1.10 |
| self_referential | 0.14 | 1.11 |
Correlation between self-referential and mentalizing ROIs. Given the high correlations, we also report sensitivity analyses with alternative, less highly correlated ROIs. Note, we do not include both ROIs in the same model, so multicollinearity is not an issue.
merged %>%
select(pID, trial, cond, atlas, parameter_estimate) %>%
spread(atlas, parameter_estimate) %>%
rmcorr::rmcorr(as.factor(pID), mentalizing, `self-referential`, data = .)##
## Repeated measures correlation
##
## r
## 0.9382227
##
## degrees of freedom
## 5928
##
## p-value
## 0
##
## 95% confidence interval
## 0.9351 0.9411998
Is greater activity in the ROIs associated with higher self and social relevance ratings?
✅ H1a: Greater activity in the self-referential ROI will be associated with higher self-relevance ratings
mod_h1a = lmer(self_relevance ~ self_referential + (1 + self_referential | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_model(mod_h1a)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.56 [2.48, 2.64] | 84.10 | 66.03 | < .001 |
| self-referential | 0.05 [0.02, 0.07] | 82.76 | 3.68 | < .001 |
summary(mod_h1a)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_relevance ~ self_referential + (1 + self_referential | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16749.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.4362 -0.7057 0.1481 0.6856 2.3548
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.114216 0.33796
## self_referential 0.001684 0.04104 -0.76
## Residual 0.916509 0.95734
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.55948 0.03876 84.09759 66.029 < 0.0000000000000002 ***
## self_referential 0.04796 0.01304 82.76293 3.679 0.000416 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## self_rfrntl -0.294
✅ H1b: Greater activity in the mentalizing ROI will be associated with higher social relevance ratings
mod_h1b = lmer(social_relevance ~ mentalizing + (1 + mentalizing | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_model(mod_h1b)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.66 [2.57, 2.74] | 84.49 | 63.77 | < .001 |
| mentalizing | 0.05 [0.02, 0.07] | 83.18 | 3.80 | < .001 |
summary(mod_h1b)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: social_relevance ~ mentalizing + (1 + mentalizing | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 15831.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.8332 -0.7255 0.1643 0.6507 2.6739
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.134404 0.36661
## mentalizing 0.002549 0.05049 -0.11
## Residual 0.781733 0.88416
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.65619 0.04165 84.49481 63.77 < 0.0000000000000002 ***
## mentalizing 0.04800 0.01263 83.18393 3.80 0.000274 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## mentalizing -0.139
predicted_h1 = ggeffects::ggpredict(mod_h1a, c("self_referential [-4.5:5]")) %>%
data.frame() %>%
mutate(roi = "self-referential",
variable = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h1b, c("mentalizing [-4.5:5]")) %>%
data.frame() %>%
mutate(roi = "mentalizing",
variable = "social relevance"))
predicted_sub_h1 = ggeffects::ggpredict(mod_h1a, terms = c("self_referential [-4.5:5]", "pID"), type = "random") %>%
data.frame() %>%
mutate(roi = "self-referential",
variable = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h1b, c("mentalizing [-4.5:5]", "pID"), type = "random") %>%
data.frame() %>%
mutate(roi = "mentalizing",
variable = "social relevance"))
predicted_h1 %>%
ggplot(aes(x, predicted)) +
stat_smooth(data = predicted_sub_h1, aes(group = group, color = roi), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high, fill = roi), alpha = .5, color = NA) +
geom_line(aes(color = roi), size = 2) +
facet_grid(~variable) +
scale_color_manual(name = "", values = palette_roi, guide = FALSE) +
scale_fill_manual(name = "", values = palette_roi, guide = FALSE) +
labs(x = "\nROI activity (SD)", y = "predicted rating\n") +
plot_aesDo the manipulations increase relevance?
❌ H2a: Self-focused intervention (compared to control) will increase self-relevance
mod_h2a = lmer(self_relevance ~ cond + (1 | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_model(mod_h2a)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.55 [2.47, 2.64] | 122.78 | 60.72 | < .001 |
| other | 0.01 [-0.05, 0.07] | 5927.28 | 0.21 | .837 |
| self | 0.03 [-0.03, 0.09] | 5927.34 | 1.09 | .276 |
summary(mod_h2a)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_relevance ~ cond + (1 | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16772.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.4268 -0.7132 0.1659 0.6723 2.3425
##
## Random effects:
## Groups Name Variance Std.Dev.
## pID (Intercept) 0.1114 0.3337
## Residual 0.9205 0.9594
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.554630 0.042071 122.778484 60.722 <0.0000000000000002 ***
## condother 0.006223 0.030305 5927.281838 0.205 0.837
## condself 0.033030 0.030313 5927.343524 1.090 0.276
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndthr
## condother -0.360
## condself -0.360 0.500
predicted_h2 = ggeffects::ggpredict(mod_h2a, c("cond")) %>%
data.frame() %>%
mutate(model = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h2b, c("cond")) %>%
data.frame() %>%
mutate(model = "social relevance")) %>%
mutate(x = factor(x, levels = c("self", "control", "other")))
predicted_sub_h2 = ggeffects::ggpredict(mod_h2a, terms = c("cond", "pID"), type = "random") %>%
data.frame() %>%
mutate(model = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h2b, c("cond", "pID"), type = "random") %>%
data.frame() %>%
mutate(model = "social relevance")) %>%
mutate(x = factor(x, levels = c("self", "control", "other")))
predicted_h2 %>%
ggplot(aes(x = x, y = predicted)) +
stat_summary(data = predicted_sub_h2, aes(group = group), fun = "mean", geom = "line",
size = .08, color = "grey50") +
stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = .5) +
facet_grid(~model) +
scale_color_manual(name = "", values = palette_condition, guide = "none") +
scale_alpha_manual(name = "", values = c(1, .5)) +
labs(x = "", y = "predicted rating\n") +
plot_aes +
theme(legend.position = c(.85, .15))Is greater self and social relevance associated with higher sharing intentions?
✅ H1a: Greater self-relevance ratings will be associated with higher sharing intentions
✅ H1a: Greater social relevance ratings will be associated with higher sharing intentions
mod_h3 = lmer(value ~ self_relevance_z + social_relevance_z + (1 + self_relevance_z + social_relevance_z | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))predicted_h3 = ggeffects::ggpredict(mod_h3, c("self_relevance_z")) %>%
data.frame() %>%
mutate(variable = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h3, c("social_relevance_z")) %>%
data.frame() %>%
mutate(variable = "social relevance"))
predicted_sub_h3 = ggeffects::ggpredict(mod_h3, terms = c("self_relevance_z", "pID"), type = "random") %>%
data.frame() %>%
mutate(variable = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h3, c("social_relevance_z", "pID"), type = "random") %>%
data.frame() %>%
mutate(variable = "social relevance"))
predicted_h3 %>%
ggplot(aes(x, predicted)) +
stat_smooth(data = predicted_sub_h3, aes(group = group, color = variable),
geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high, fill = variable), alpha = .2, color = NA) +
geom_line(aes(color = variable), size = 1.5) +
facet_grid(~variable) +
scale_color_manual(name = "", values = palette_dv[1:2]) +
scale_fill_manual(name = "", values = palette_dv[1:2]) +
labs(x = "\nrelevance rating", y = "predicted sharing intention rating\n") +
plot_aes +
theme(legend.position = "none")table_model(mod_h3)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.63 [2.58, 2.69] | 83.46 | 95.86 | < .001 |
| self-relevance | 0.31 [0.27, 0.35] | 85.60 | 15.59 | < .001 |
| social relevance | 0.24 [0.19, 0.29] | 82.45 | 9.75 | < .001 |
summary(mod_h3)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## value ~ self_relevance_z + social_relevance_z + (1 + self_relevance_z +
## social_relevance_z | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 14904.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3650 -0.7051 0.0600 0.6939 3.0503
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.05280 0.2298
## self_relevance_z 0.01218 0.1103 -0.39
## social_relevance_z 0.02941 0.1715 0.21 -0.55
## Residual 0.68662 0.8286
## Number of obs: 5935, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.63303 0.02747 83.46378 95.857 < 0.0000000000000002
## self_relevance_z 0.30924 0.01983 85.60222 15.592 < 0.0000000000000002
## social_relevance_z 0.24092 0.02470 82.44618 9.755 0.00000000000000216
##
## (Intercept) ***
## self_relevance_z ***
## social_relevance_z ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) slf_r_
## slf_rlvnc_z -0.220
## scl_rlvnc_z 0.144 -0.596
Deviations:
Do the manipulations increase neural activity in brain regions associated with self-referential processing and mentalizing?
✅ H4a: Self-focused intervention (compared to control) will increase brain activity in ROIs related to self-referential processes.
mod_h4a = lmer(self_referential ~ cond + (1 + cond | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_model(mod_h4a)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 0.08 [-0.03, 0.20] | 84.07 | 1.46 | .147 |
| other | 0.09 [0.01, 0.16] | 83.53 | 2.19 | .032 |
| self | 0.09 [0.00, 0.17] | 83.67 | 2.06 | .043 |
summary(mod_h4a)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_referential ~ cond + (1 + cond | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 17285
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.7918 -0.6605 0.0028 0.6473 3.6030
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.23308 0.4828
## condother 0.04602 0.2145 -0.18
## condself 0.07364 0.2714 -0.07 0.59
## Residual 0.97964 0.9898
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.08318 0.05685 84.06811 1.463 0.1471
## condother 0.08524 0.03898 83.53399 2.187 0.0316 *
## condself 0.08831 0.04295 83.66777 2.056 0.0429 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndthr
## condother -0.321
## condself -0.246 0.534
❌ H4b: Other-focused intervention (compared to control) will increase brain activity in ROIs related to mentalizing processes.
The other condition is associated with increased activation in the mentalizing ROI, but the relationship is not statistically significant.
mod_h4b = lmer(mentalizing ~ cond + (1 + cond | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_model(mod_h4b)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 0.33 [0.22, 0.44] | 84.10 | 5.93 | < .001 |
| other | 0.06 [-0.02, 0.14] | 83.34 | 1.58 | .117 |
| self | 0.07 [-0.01, 0.16] | 83.73 | 1.72 | .089 |
summary(mod_h4b)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: mentalizing ~ cond + (1 + cond | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 17288.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6193 -0.6570 0.0214 0.6732 3.3254
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.21885 0.4678
## condother 0.03877 0.1969 -0.19
## condself 0.06933 0.2633 -0.05 0.61
## Residual 0.98228 0.9911
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.32819 0.05537 84.09838 5.928 0.0000000656 ***
## condother 0.05999 0.03790 83.34488 1.583 0.1173
## condself 0.07296 0.04239 83.72979 1.721 0.0889 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndthr
## condother -0.331
## condself -0.240 0.537
predicted_h4 = ggeffects::ggpredict(mod_h4a, c("cond")) %>%
data.frame() %>%
mutate(atlas = "self-referential") %>%
bind_rows(ggeffects::ggpredict(mod_h4b, c("cond")) %>%
data.frame() %>%
mutate(atlas = "mentalizing")) %>%
mutate(x = factor(x, levels = c("self", "control", "other")),
atlas = factor(atlas, levels = c("self-referential", "mentalizing")))
predicted_sub_h4 = ggeffects::ggpredict(mod_h4a, terms = c("cond", "pID"), type = "random") %>%
data.frame() %>%
mutate(atlas = "self-referential") %>%
bind_rows(ggeffects::ggpredict(mod_h4b, c("cond", "pID"), type = "random") %>%
data.frame() %>%
mutate(atlas = "mentalizing")) %>%
mutate(x = factor(x, levels = c("self", "control", "other")),
atlas = factor(atlas, levels = c("self-referential", "mentalizing")))
predicted_h4 %>%
ggplot(aes(x = x, y = predicted)) +
stat_summary(data = predicted_sub_h4, aes(group = group), fun = "mean", geom = "line",
size = .1, color = "grey50") +
stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = .75) +
facet_grid(~atlas) +
scale_color_manual(name = "", values = palette_condition, guide = "none") +
scale_alpha_manual(name = "", values = c(1, .5)) +
labs(x = "", y = "predicted ROI activity (SD)\n") +
plot_aesDo the manipulations increase sharing intentions?
❌ H5a: Self-focused intervention (compared to control) will increase sharing intentions
❌ H5b: Other-focused intervention (compared to control) will increase sharing intentions
mod_h5 = lmer(value ~ cond + (1 | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))predicted_h5 = ggeffects::ggpredict(mod_h5, c("cond")) %>%
data.frame() %>%
mutate(x = factor(x, levels = c("self", "control", "other")))
predicted_sub_h5 = ggeffects::ggpredict(mod_h5, terms = c("cond", "pID"), type = "random") %>%
data.frame() %>%
mutate(x = factor(x, levels = c("self", "control", "other")))
predicted_h5 %>%
ggplot(aes(x = x, y = predicted)) +
stat_summary(data = predicted_sub_h5, aes(group = group), fun = "mean", geom = "line",
size = .25, color = "grey50") +
stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1.5) +
geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = 1.5) +
scale_color_manual(name = "", values = palette_condition, guide = "none") +
scale_alpha_manual(name = "", values = c(1, .5)) +
labs(x = "", y = "predicted sharing intention\n") +
plot_aes +
theme(legend.position = c(.85, .15))table_model(mod_h5)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.65 [2.56, 2.73] | 126.10 | 63.68 | < .001 |
| other | -0.03 [-0.09, 0.03] | 5848.55 | -1.06 | .290 |
| self | -0.04 [-0.11, 0.02] | 5848.60 | -1.45 | .147 |
summary(mod_h5)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ cond + (1 | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16672.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.5571 -0.7077 0.1147 0.7259 2.0377
##
## Random effects:
## Groups Name Variance Std.Dev.
## pID (Intercept) 0.1063 0.3261
## Residual 0.9399 0.9695
## Number of obs: 5935, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.64574 0.04155 126.10176 63.680 <0.0000000000000002 ***
## condother -0.03265 0.03082 5848.54880 -1.059 0.290
## condself -0.04468 0.03084 5848.59677 -1.449 0.147
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndthr
## condother -0.371
## condself -0.371 0.500
Is ROI activity positively related to sharing intentions?
✅ H6a: Stronger activity in the self-referential ROI will be related to higher sharing intentions.
mod_h6a = lmer(value ~ self_referential + (1 + self_referential | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_model(mod_h6a)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.61 [2.53, 2.68] | 84.43 | 68.73 | < .001 |
| self-referential | 0.08 [0.06, 0.11] | 81.64 | 6.11 | < .001 |
summary(mod_h6a)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ self_referential + (1 + self_referential | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16625
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.5959 -0.7247 0.1135 0.7333 2.2539
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.108148 0.32886
## self_referential 0.002504 0.05004 -0.22
## Residual 0.930334 0.96454
## Number of obs: 5935, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.60694 0.03793 84.42967 68.725 < 0.0000000000000002 ***
## self_referential 0.08314 0.01360 81.63664 6.113 0.0000000319 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## self_rfrntl -0.128
✅ H6b: Stronger activation in the mentalizing ROI will be related to higher sharing intentions.
mod_h6b = lmer(value ~ mentalizing + (1 + mentalizing | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_model(mod_h6b)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.59 [2.52, 2.67] | 85.39 | 67.94 | < .001 |
| mentalizing | 0.07 [0.05, 0.10] | 81.87 | 5.48 | < .001 |
summary(mod_h6b)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ mentalizing + (1 + mentalizing | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16635.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.5853 -0.7230 0.1157 0.7363 2.1999
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.108020 0.32866
## mentalizing 0.002117 0.04602 -0.11
## Residual 0.932277 0.96555
## Number of obs: 5935, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.59181 0.03815 85.39359 67.938 < 0.0000000000000002 ***
## mentalizing 0.07367 0.01345 81.87396 5.477 0.000000465 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## mentalizing -0.151
vals = seq(-4.5, 4.5, .1)
predicted_h6 = ggeffects::ggpredict(mod_h6a, c("self_referential [vals]")) %>%
data.frame() %>%
mutate(roi = "self-referential") %>%
bind_rows(ggeffects::ggpredict(mod_h6b, c("mentalizing [vals]")) %>%
data.frame() %>%
mutate(roi = "mentalizing")) %>%
mutate(roi = factor(roi, levels = c("self-referential", "mentalizing")))
predicted_sub_h6 = ggeffects::ggpredict(mod_h6a, terms = c("self_referential [vals]", "pID"), type = "random") %>%
data.frame() %>%
mutate(roi = "self-referential") %>%
bind_rows(ggeffects::ggpredict(mod_h6b, c("mentalizing [vals]", "pID"), type = "random") %>%
data.frame() %>%
mutate(roi = "mentalizing")) %>%
mutate(roi = factor(roi, levels = c("self-referential", "mentalizing")))
predicted_h6 %>%
ggplot(aes(x = x, y = predicted, color = roi, fill = roi)) +
stat_smooth(data = predicted_sub_h6, aes(group = group), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
geom_line(size = 2) +
facet_grid(~roi) +
scale_color_manual(name = "", values = palette_roi) +
scale_fill_manual(name = "", values = palette_roi) +
labs(y = "predicted sharing intention\n", x = "\nROI activity (SD)") +
plot_aes +
theme(legend.position = "none")Is there an indirect effect of the condition on sharing intentions through activity in self-referential and mentalizing ROIs?
# source functions
source("indirectMLM.R")
# create self condition dataframe
data_med_self = merged_wide %>%
filter(!cond == "other") %>%
mutate(cond = ifelse(cond == "self", 1, 0)) %>%
select(pID, site, trial, cond, value, self_referential) %>%
data.frame()
# create social condition dataframe
data_med_other = merged_wide %>%
filter(!cond == "self") %>%
mutate(cond = ifelse(cond == "other", 1, 0)) %>%
select(pID, site, trial, cond, value, mentalizing) %>%
data.frame()
# define variables
y_var = "value"✅ H7a: The effect of Self-focused intervention on sharing intention is mediated by increased activity in the self-referential ROI.
model_name = "mediation_self"
data = data_med_self
if (file.exists(sprintf("models/model_%s.RDS", model_name))) {
assign(get("model_name"), readRDS(sprintf("models/model_%s.RDS", model_name)))
} else {
assign(get("model_name"), boot(data = data, statistic = indirect.mlm, R = 500,
y = y_var, x = "cond", mediator = "self_referential", group.id = "pID",
between.m = F, uncentered.x = F))
saveRDS(eval(parse(text = model_name)), sprintf("models/model_%s.RDS", model_name))
}
indirect.mlm.summary(get(model_name))## #### Population Covariance ####
## Covariance of Random Slopes a and b: 0.001 [-0.002, 0.011]
##
##
## #### Indirect Effects ####
## # Within-subject Effects
## Unbiased Estimate of Within-subjects Indirect Effect: 0.009 [0.003, 0.02]
## Biased Estimate of Within-subjects Indirect Effect: 0.007 [0.002, 0.013]
## Bias in Within-subjects Indirect Effect: 0.001 [0, 0.011]
##
##
## #### Total Effect ####
## Unbiased Estimate of Total Effect: -0.046 [-0.11, 0.01]
## Biased Total Effect of X on Y (c path): -0.044 [-0.109, 0.012]
## Bias in Total Effect: 0.002 [0, 0.006]
##
##
## #### Direct Effects ####
## Direct Effect of Predictor on Dependent Variable (c' path): -0.055 [-0.121, 0]
## Within-subjects Effect of Predictor on Mediator (a path for group-mean centered predictor): 0.088 [0.024, 0.146]
## Within-subjects Effect of Mediator on Dependent Variable (b path for group-mean centered mediator): 0.084 [0.05, 0.113]
❌ H7b: The effect of Other-focused intervention on sharing intention is mediated by increased activity in the mentalizing ROI.
model_name = "mediation_other"
data = data_med_other
if (file.exists(sprintf("models/model_%s.RDS", model_name))) {
assign(get("model_name"), readRDS(sprintf("models/model_%s.RDS", model_name)))
} else {
assign(get("model_name"), boot(data = data, statistic = indirect.mlm, R = 500,
y = y_var, x = "cond", mediator = "mentalizing", group.id = "pID",
between.m = F, uncentered.x = F))
saveRDS(eval(parse(text = model_name)), sprintf("models/model_%s.RDS", model_name))
}
indirect.mlm.summary(get(model_name))## #### Population Covariance ####
## Covariance of Random Slopes a and b: -0.001 [-0.005, 0.007]
##
##
## #### Indirect Effects ####
## # Within-subject Effects
## Unbiased Estimate of Within-subjects Indirect Effect: 0.004 [-0.001, 0.015]
## Biased Estimate of Within-subjects Indirect Effect: 0.005 [0, 0.011]
## Bias in Within-subjects Indirect Effect: 0.001 [0, 0.007]
##
##
## #### Total Effect ####
## Unbiased Estimate of Total Effect: -0.031 [-0.09, 0.029]
## Biased Total Effect of X on Y (c path): -0.032 [-0.09, 0.029]
## Bias in Total Effect: 0.001 [0, 0.005]
##
##
## #### Direct Effects ####
## Direct Effect of Predictor on Dependent Variable (c' path): -0.036 [-0.095, 0.025]
## Within-subjects Effect of Predictor on Mediator (a path for group-mean centered predictor): 0.06 [-0.002, 0.117]
## Within-subjects Effect of Mediator on Dependent Variable (b path for group-mean centered mediator): 0.083 [0.054, 0.119]
These analyses explore whether the analyses reported in study 1 of the main manuscript are moderated by cultural context (the Netherlands or the USA).
Are the relationships between ROI activity and self and social relevance ratings moderated by cultural context?
These data are not consistent with moderation by cultural context.
mod_h1am = lmer(self_relevance ~ self_referential * site + (1 + self_referential | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_h1am = table_model(mod_h1am, print = FALSE)
table_h1am %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.61 [2.50, 2.72] | 82.64 | 46.36 | < .001 |
| self-referential | 0.04 [0.00, 0.08] | 84.47 | 2.23 | .028 |
| sample (USA) | -0.09 [-0.25, 0.06] | 83.66 | -1.21 | .229 |
| self-referential x sample (USA) | 0.01 [-0.04, 0.06] | 82.89 | 0.42 | .673 |
simple_slopes(mod_h1am, "self_referential", "site")| site | b [95% CI] |
|---|---|
| Netherlands | 0.04 [0.01, 0.08] |
| USA | 0.05 [0.02, 0.09] |
summary(mod_h1am)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_relevance ~ self_referential * site + (1 + self_referential |
## pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16756.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.4404 -0.7064 0.1525 0.6834 2.3586
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.113508 0.3369
## self_referential 0.001841 0.0429 -0.72
## Residual 0.916497 0.9573
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 2.60867 0.05627 82.64206 46.359
## self_referential 0.04301 0.01924 84.46525 2.235
## siteUSA -0.09399 0.07759 83.66019 -1.211
## self_referential:siteUSA 0.01116 0.02634 82.88805 0.424
## Pr(>|t|)
## (Intercept) <0.0000000000000002 ***
## self_referential 0.0281 *
## siteUSA 0.2291
## self_referential:siteUSA 0.6730
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) slf_rf sitUSA
## self_rfrntl -0.220
## siteUSA -0.725 0.160
## slf_rfr:USA 0.161 -0.731 -0.280
These data are not consistent with moderation by cultural context.
mod_h1bm = lmer(social_relevance ~ mentalizing * site + (1 + mentalizing | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_h1bm = table_model(mod_h1bm, print = FALSE)
table_h1bm %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.73 [2.61, 2.84] | 81.87 | 45.55 | < .001 |
| mentalizing | 0.04 [0.01, 0.08] | 83.25 | 2.42 | .018 |
| sample (USA) | -0.13 [-0.30, 0.03] | 83.42 | -1.61 | .111 |
| mentalizing x sample (USA) | 0.01 [-0.04, 0.06] | 82.63 | 0.29 | .772 |
simple_slopes(mod_h1bm, "mentalizing", "site")| site | b [95% CI] |
|---|---|
| Netherlands | 0.04 [0.01, 0.08] |
| USA | 0.05 [0.02, 0.09] |
summary(mod_h1bm)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: social_relevance ~ mentalizing * site + (1 + mentalizing | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 15837.6
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.8378 -0.7241 0.1647 0.6494 2.6771
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.131492 0.3626
## mentalizing 0.002735 0.0523 -0.10
## Residual 0.781712 0.8841
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.725840 0.059842 81.872635 45.550 <0.0000000000000002
## mentalizing 0.044925 0.018588 83.247748 2.417 0.0178
## siteUSA -0.133130 0.082656 83.423642 -1.611 0.1110
## mentalizing:siteUSA 0.007401 0.025505 82.631141 0.290 0.7724
##
## (Intercept) ***
## mentalizing *
## siteUSA
## mentalizing:siteUSA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) mntlzn sitUSA
## mentalizing -0.088
## siteUSA -0.724 0.064
## mntlzng:USA 0.064 -0.729 -0.129
vals = seq(-4.5,4.5,.1)
predicted_h1m = ggeffects::ggpredict(mod_h1am, c("self_referential [vals]", "site")) %>%
data.frame() %>%
mutate(roi = "self-referential",
variable = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h1bm, c("mentalizing [vals]", "site")) %>%
data.frame() %>%
mutate(roi = "mentalizing",
variable = "social relevance"))
predicted_sub_h1m = ggeffects::ggpredict(mod_h1am, terms = c("self_referential [vals]", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(roi = "self-referential",
variable = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h1bm, c("mentalizing [vals]", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(roi = "mentalizing",
variable = "social relevance")) %>%
filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))
predicted_h1m %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
stat_smooth(data = predicted_sub_h1m, aes(group = interaction(group, facet)),
geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .3, color = NA) +
geom_line(size = 2) +
facet_grid(~variable) +
scale_color_manual(name = "", values = palette_sample) +
scale_fill_manual(name = "", values = palette_sample) +
labs(x = "\nROI activity (SD)", y = "predicted rating\n") +
plot_aes +
theme(legend.position = "top",
legend.key.width=unit(2,"cm"))Are the effects of the experimental manipulations on relevance moderated by cultural context?
These data are not consistent with moderation by cultural context.
mod_h2am = lmer(self_relevance ~ cond * site + (1 | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_h2am = table_model(mod_h2am, print = FALSE)
table_h2am %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.58 [2.46, 2.70] | 121.34 | 42.05 | < .001 |
| other | 0.04 [-0.05, 0.12] | 5925.43 | 0.83 | .409 |
| self | 0.04 [-0.05, 0.13] | 5925.22 | 0.89 | .372 |
| sample (USA) | -0.05 [-0.22, 0.12] | 121.28 | -0.58 | .560 |
| other x sample (USA) | -0.06 [-0.18, 0.06] | 5925.30 | -0.94 | .347 |
| self x sample (USA) | -0.01 [-0.13, 0.11] | 5925.33 | -0.20 | .843 |
simple_slopes(mod_h2am, "cond", "site", continuous = FALSE)| contrast | site | b [95% CI] |
|---|---|---|
| other - control | Netherlands | 0.04 [-0.05, 0.12] |
| other - control | USA | -0.02 [-0.10, 0.06] |
| self - control | Netherlands | 0.04 [-0.05, 0.13] |
| self - control | USA | 0.03 [-0.05, 0.11] |
summary(mod_h2am)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_relevance ~ cond * site + (1 | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16782.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.4248 -0.7129 0.1645 0.6768 2.3191
##
## Random effects:
## Groups Name Variance Std.Dev.
## pID (Intercept) 0.1116 0.3340
## Residual 0.9207 0.9595
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.58073 0.06137 121.33562 42.049 <0.0000000000000002
## condother 0.03648 0.04422 5925.43253 0.825 0.409
## condself 0.03942 0.04417 5925.21630 0.892 0.372
## siteUSA -0.04932 0.08434 121.27906 -0.585 0.560
## condother:siteUSA -0.05705 0.06073 5925.30374 -0.940 0.347
## condself:siteUSA -0.01204 0.06073 5925.33153 -0.198 0.843
##
## (Intercept) ***
## condother
## condself
## siteUSA
## condother:siteUSA
## condself:siteUSA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndthr cndslf sitUSA cndt:USA
## condother -0.360
## condself -0.361 0.501
## siteUSA -0.728 0.262 0.262
## cndthr:sUSA 0.262 -0.728 -0.364 -0.360
## cndslf:sUSA 0.262 -0.364 -0.727 -0.360 0.500
predicted_h2m = ggeffects::ggpredict(mod_h2am, c("cond", "site")) %>%
data.frame() %>%
mutate(model = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h2bm, c("cond", "site")) %>%
data.frame() %>%
mutate(model = "social relevance")) %>%
mutate(x = factor(x, levels = c("self", "control", "other")))
predicted_sub_h2m = ggeffects::ggpredict(mod_h2am, terms = c("cond", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(model = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h2bm, c("cond", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(model = "social relevance")) %>%
mutate(x = factor(x, levels = c("self", "control", "other"))) %>%
filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))
predicted_h2m %>%
ggplot(aes(x = x, y = predicted, color = group)) +
stat_summary(data = predicted_sub_h2m, aes(group = interaction(group, facet)), fun = "mean", geom = "line", size = .1, alpha = .5) +
stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
size = .75) +
facet_grid(~model) +
scale_color_manual(name = "", values = palette_sample) +
labs(x = "", y = "predicted rating\n") +
plot_aes +
theme(legend.position = c(.85, .15))Are the relationships between self and social relevance and sharing intentions moderated by cultural context?
These data are not consistent with moderation by cultural context.
mod_h3m = lmer(value ~ self_relevance_z * site + social_relevance_z * site + (1 + self_relevance_z + social_relevance_z | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))predicted_h3m = ggeffects::ggpredict(mod_h3m, c("self_relevance_z", "site")) %>%
data.frame() %>%
mutate(variable = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h3m, c("social_relevance_z", "site")) %>%
data.frame() %>%
mutate(variable = "social relevance"))
predicted_sub_h3m = ggeffects::ggpredict(mod_h3m, terms = c("self_relevance_z", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(variable = "self-relevance") %>%
bind_rows(ggeffects::ggpredict(mod_h3m, c("social_relevance_z", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(variable = "social relevance")) %>%
filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))
predicted_h3m %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
stat_smooth(data = predicted_sub_h3m, aes(group = interaction(group, facet)),
geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .3, color = NA) +
geom_line(size = 2) +
facet_grid(~variable) +
scale_color_manual(name = "", values = palette_sample) +
scale_fill_manual(name = "", values = palette_sample) +
labs(x = "\nrating (SD)", y = "predicted sharing intention\n") +
plot_aes +
theme(legend.key.width=unit(2,"cm"))table_h3m = table_model(mod_h3m, print = FALSE)
table_h3m %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.58 [2.50, 2.66] | 82.76 | 65.19 | < .001 |
| self-relevance | 0.33 [0.27, 0.39] | 89.64 | 11.01 | < .001 |
| sample (USA) | 0.10 [-0.01, 0.21] | 82.28 | 1.78 | .078 |
| social relevance | 0.22 [0.15, 0.29] | 88.54 | 5.95 | < .001 |
| self-relevance x sample (USA) | -0.03 [-0.11, 0.04] | 84.71 | -0.87 | .385 |
| sample (USA) x social relevance | 0.04 [-0.06, 0.14] | 82.51 | 0.79 | .429 |
simple_slopes(mod_h3m, "self_relevance_z", "site", continuous = TRUE)| site | b [95% CI] |
|---|---|
| Netherlands | 0.33 [0.27, 0.39] |
| USA | 0.29 [0.24, 0.35] |
summary(mod_h3m)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ self_relevance_z * site + social_relevance_z * site +
## (1 + self_relevance_z + social_relevance_z | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 14914.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3723 -0.6976 0.0547 0.6917 3.0523
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.05116 0.2262
## self_relevance_z 0.01209 0.1099 -0.38
## social_relevance_z 0.02958 0.1720 0.20 -0.55
## Residual 0.68672 0.8287
## Number of obs: 5935, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 2.58183 0.03960 82.75581 65.195
## self_relevance_z 0.32807 0.02979 89.64063 11.013
## siteUSA 0.09691 0.05435 82.28351 1.783
## social_relevance_z 0.22002 0.03698 88.54233 5.949
## self_relevance_z:siteUSA -0.03484 0.03989 84.70853 -0.874
## siteUSA:social_relevance_z 0.03956 0.04977 82.51259 0.795
## Pr(>|t|)
## (Intercept) < 0.0000000000000002 ***
## self_relevance_z < 0.0000000000000002 ***
## siteUSA 0.0782 .
## social_relevance_z 0.0000000528 ***
## self_relevance_z:siteUSA 0.3849
## siteUSA:social_relevance_z 0.4289
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) slf_r_ sitUSA scl_r_ s__:US
## slf_rlvnc_z -0.200
## siteUSA -0.729 0.146
## scl_rlvnc_z 0.112 -0.590 -0.082
## slf_rl_:USA 0.149 -0.747 -0.210 0.441
## stUSA:scl__ -0.083 0.439 0.129 -0.743 -0.593
Are the effects of the experimental manipulations on ROI activity moderated by cultural context?
There is a main effect of site, such that the American cohort has greater activity in the self-referential ROI compared to the Dutch cohort.
These data are not consistent with moderation by cultural context.
mod_h4am = lmer(self_referential ~ cond * site + (1 + cond | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_h4am = table_model(mod_h4am, print = FALSE)
table_h4am %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | -0.14 [-0.29, 0.01] | 83.01 | -1.87 | .064 |
| other | 0.10 [-0.01, 0.22] | 82.72 | 1.81 | .074 |
| self | 0.08 [-0.05, 0.20] | 82.60 | 1.23 | .222 |
| sample (USA) | 0.43 [0.22, 0.63] | 82.99 | 4.08 | < .001 |
| other x sample (USA) | -0.03 [-0.19, 0.12] | 82.55 | -0.44 | .663 |
| self x sample (USA) | 0.02 [-0.15, 0.19] | 82.68 | 0.24 | .814 |
simple_slopes(mod_h4am, "cond", "site", continuous = FALSE)| contrast | site | b [95% CI] |
|---|---|---|
| other - control | Netherlands | 0.10 [-0.01, 0.22] |
| other - control | USA | 0.07 [-0.04, 0.17] |
| self - control | Netherlands | 0.08 [-0.05, 0.20] |
| self - control | USA | 0.10 [-0.02, 0.21] |
summary(mod_h4am)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_referential ~ cond * site + (1 + cond | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 17277.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.7968 -0.6584 0.0043 0.6447 3.6151
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.18992 0.4358
## condother 0.04730 0.2175 -0.17
## condself 0.07548 0.2747 -0.10 0.59
## Residual 0.97964 0.9898
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) -0.14260 0.07608 83.01345 -1.874 0.064421 .
## condother 0.10338 0.05713 82.72167 1.810 0.073998 .
## condself 0.07752 0.06296 82.59520 1.231 0.221714
## siteUSA 0.42645 0.10456 82.98789 4.079 0.000104 ***
## condother:siteUSA -0.03429 0.07848 82.55150 -0.437 0.663349
## condself:siteUSA 0.02041 0.08655 82.67692 0.236 0.814160
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndthr cndslf sitUSA cndt:USA
## condother -0.331
## condself -0.282 0.536
## siteUSA -0.728 0.241 0.205
## cndthr:sUSA 0.241 -0.728 -0.390 -0.331
## cndslf:sUSA 0.205 -0.390 -0.727 -0.281 0.536
There is a main effect of site, such that the American cohort has greater activity in the self-referential ROI compared to the Dutch cohort.
These data are not consistent with moderation by cultural context.
mod_h4bm = lmer(mentalizing ~ cond * site + (1 + cond | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_h4bm = table_model(mod_h4bm, print = FALSE)
table_h4bm %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 0.12 [-0.03, 0.27] | 83.11 | 1.66 | .102 |
| other | 0.11 [0.00, 0.22] | 82.55 | 2.01 | .047 |
| self | 0.07 [-0.06, 0.19] | 82.65 | 1.10 | .276 |
| sample (USA) | 0.38 [0.18, 0.59] | 83.09 | 3.73 | < .001 |
| other x sample (USA) | -0.10 [-0.25, 0.05] | 82.37 | -1.27 | .208 |
| self x sample (USA) | 0.01 [-0.16, 0.18] | 82.73 | 0.11 | .915 |
simple_slopes(mod_h4bm, "cond", "site", continuous = FALSE)| contrast | site | b [95% CI] |
|---|---|---|
| other - control | Netherlands | 0.11 [0.00, 0.22] |
| other - control | USA | 0.01 [-0.09, 0.12] |
| self - control | Netherlands | 0.07 [-0.05, 0.19] |
| self - control | USA | 0.08 [-0.04, 0.19] |
summary(mod_h4bm)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: mentalizing ~ cond * site + (1 + cond | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 17283.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6509 -0.6550 0.0194 0.6722 3.3344
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.18415 0.4291
## condother 0.03791 0.1947 -0.10
## condself 0.07119 0.2668 -0.07 0.63
## Residual 0.98227 0.9911
## Number of obs: 6014, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.12439 0.07515 83.11419 1.655 0.101642
## condother 0.11088 0.05509 82.55134 2.013 0.047401 *
## condself 0.06819 0.06215 82.64788 1.097 0.275746
## siteUSA 0.38494 0.10327 83.08754 3.727 0.000352 ***
## condother:siteUSA -0.09608 0.07568 82.36613 -1.270 0.207806
## condself:siteUSA 0.00910 0.08544 82.73055 0.107 0.915436
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndthr cndslf sitUSA cndt:USA
## condother -0.305
## condself -0.264 0.544
## siteUSA -0.728 0.222 0.192
## cndthr:sUSA 0.222 -0.728 -0.396 -0.305
## cndslf:sUSA 0.192 -0.396 -0.727 -0.264 0.544
predicted_h4m = ggeffects::ggpredict(mod_h4am, c("cond", "site")) %>%
data.frame() %>%
mutate(atlas = "self-referential") %>%
bind_rows(ggeffects::ggpredict(mod_h4bm, c("cond", "site")) %>%
data.frame() %>%
mutate(atlas = "mentalizing")) %>%
mutate(x = factor(x, levels = c("self", "control", "other")),
atlas = factor(atlas, levels = c("self-referential", "mentalizing")))
predicted_sub_h4m = ggeffects::ggpredict(mod_h4am, terms = c("cond", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(atlas = "self-referential") %>%
bind_rows(ggeffects::ggpredict(mod_h4bm, c("cond", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(atlas = "mentalizing")) %>%
mutate(x = factor(x, levels = c("self", "control", "other")),
atlas = factor(atlas, levels = c("self-referential", "mentalizing"))) %>%
filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))
predicted_h4m %>%
ggplot(aes(x = x, y = predicted, color = group)) +
stat_summary(data = predicted_sub_h4m, aes(group = interaction(group, facet)), fun = "mean", geom = "line", size = .1) +
stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
size = .75, position = position_dodge(.1)) +
facet_grid(~atlas) +
scale_color_manual(name = "", values = palette_sample) +
labs(x = "", y = "predicted ROI activity (SD)\n") +
plot_aes +
theme(legend.position = c(.18, .95))Are the effects of the experimental manipulations on sharing intentions moderated by cultural context?
These data are not consistent with moderation by cultural context.
mod_h5m = lmer(value ~ cond * site + (1 | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))predicted_h5m = ggeffects::ggpredict(mod_h5m, c("cond", "site")) %>%
data.frame() %>%
mutate(x = factor(x, levels = c("self", "control", "other")))
predicted_sub_h5m = ggeffects::ggpredict(mod_h5m, terms = c("cond", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(x = factor(x, levels = c("self", "control", "other"))) %>%
filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))
predicted_h5m %>%
ggplot(aes(x = x, y = predicted, color = group)) +
stat_summary(data = predicted_sub_h5m, aes(group = interaction(group, facet)), fun = "mean", geom = "line", size = .1) +
stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
size = .75, position = position_dodge(.1)) +
scale_color_manual(name = "", values = palette_sample) +
labs(x = "", y = "predicted sharing intention\n") +
plot_aes +
theme(legend.position = c(.85, .15))table_h5m = table_model(mod_h5m, print = FALSE)
table_h5m %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.61 [2.49, 2.73] | 124.80 | 43.00 | < .001 |
| other | -0.01 [-0.10, 0.08] | 5846.72 | -0.26 | .792 |
| self | -0.05 [-0.14, 0.04] | 5846.54 | -1.07 | .283 |
| sample (USA) | 0.06 [-0.11, 0.22] | 124.32 | 0.70 | .483 |
| other x sample (USA) | -0.04 [-0.16, 0.08] | 5846.55 | -0.63 | .528 |
| self x sample (USA) | 0.01 [-0.11, 0.13] | 5846.55 | 0.11 | .909 |
simple_slopes(mod_h5m, "cond", "site", continuous = FALSE)| contrast | site | b [95% CI] |
|---|---|---|
| other - control | Netherlands | -0.01 [-0.10, 0.08] |
| other - control | USA | -0.05 [-0.13, 0.03] |
| self - control | Netherlands | -0.05 [-0.14, 0.04] |
| self - control | USA | -0.04 [-0.12, 0.04] |
summary(mod_h5m)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ cond * site + (1 | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16682.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.5651 -0.7038 0.1163 0.7265 2.0366
##
## Random effects:
## Groups Name Variance Std.Dev.
## pID (Intercept) 0.1071 0.3273
## Residual 0.9401 0.9696
## Number of obs: 5935, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 2.614614 0.060805 124.802819 43.000
## condother -0.011887 0.045106 5846.721712 -0.264
## condself -0.048350 0.045042 5846.539744 -1.073
## siteUSA 0.058686 0.083487 124.324082 0.703
## condother:siteUSA -0.038949 0.061781 5846.545043 -0.630
## condself:siteUSA 0.007039 0.061799 5846.553373 0.114
## Pr(>|t|)
## (Intercept) <0.0000000000000002 ***
## condother 0.792
## condself 0.283
## siteUSA 0.483
## condother:siteUSA 0.528
## condself:siteUSA 0.909
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) cndthr cndslf sitUSA cndt:USA
## condother -0.371
## condself -0.372 0.501
## siteUSA -0.728 0.270 0.271
## cndthr:sUSA 0.271 -0.730 -0.366 -0.370
## cndslf:sUSA 0.271 -0.365 -0.729 -0.370 0.500
Are the relationships between ROI activity positively and sharing intentions moderated by cultural context?
These data are not consistent with moderation by cultural context.
mod_h6am = lmer(value ~ self_referential * site + (1 + self_referential | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_h6am = table_model(mod_h6am, print = FALSE)
table_h6am %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.60 [2.49, 2.71] | 82.89 | 46.74 | < .001 |
| self-referential | 0.06 [0.02, 0.10] | 82.76 | 3.10 | .003 |
| sample (USA) | 0.01 [-0.15, 0.16] | 83.88 | 0.09 | .928 |
| self-referential x sample (USA) | 0.04 [-0.01, 0.09] | 81.13 | 1.51 | .135 |
simple_slopes(mod_h6am, "self_referential", "site", continuous = TRUE)| site | b [95% CI] |
|---|---|
| Netherlands | 0.06 [0.02, 0.10] |
| USA | 0.10 [0.07, 0.14] |
summary(mod_h6am)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ self_referential * site + (1 + self_referential | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16631.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.6103 -0.7252 0.1129 0.7407 2.3052
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.109994 0.33165
## self_referential 0.002208 0.04699 -0.25
## Residual 0.930349 0.96455
## Number of obs: 5935, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 2.599556 0.055618 82.886354 46.739
## self_referential 0.061185 0.019764 82.757891 3.096
## siteUSA 0.006967 0.076680 83.881555 0.091
## self_referential:siteUSA 0.040843 0.027064 81.132534 1.509
## Pr(>|t|)
## (Intercept) < 0.0000000000000002 ***
## self_referential 0.00268 **
## siteUSA 0.92782
## self_referential:siteUSA 0.13514
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) slf_rf sitUSA
## self_rfrntl -0.063
## siteUSA -0.725 0.046
## slf_rfr:USA 0.046 -0.730 -0.123
These data are not consistent with moderation by cultural context.
mod_h6bm = lmer(value ~ mentalizing * site + (1 + mentalizing | pID),
data = merged_wide,
control = lmerControl(optimizer = "bobyqa"))table_h6bm = table_model(mod_h6bm, print = FALSE)
table_h6bm %>%
kable() %>%
kableExtra::kable_styling()| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| intercept | 2.58 [2.47, 2.69] | 82.49 | 46.45 | < .001 |
| mentalizing | 0.06 [0.02, 0.10] | 82.57 | 3.10 | .003 |
| sample (USA) | 0.01 [-0.14, 0.17] | 84.55 | 0.17 | .865 |
| mentalizing x sample (USA) | 0.02 [-0.03, 0.08] | 81.34 | 0.87 | .389 |
simple_slopes(mod_h6bm, "mentalizing", "site", continuous = TRUE)| site | b [95% CI] |
|---|---|
| Netherlands | 0.06 [0.02, 0.10] |
| USA | 0.08 [0.05, 0.12] |
summary(mod_h6bm)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ mentalizing * site + (1 + mentalizing | pID)
## Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 16643.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.5921 -0.7264 0.1166 0.7388 2.2269
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## pID (Intercept) 0.109493 0.33090
## mentalizing 0.002132 0.04618 -0.12
## Residual 0.932303 0.96556
## Number of obs: 5935, groups: pID, 85
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.58314 0.05561 82.48970 46.453 < 0.0000000000000002
## mentalizing 0.06101 0.01971 82.57202 3.096 0.00268
## siteUSA 0.01312 0.07693 84.55322 0.171 0.86497
## mentalizing:siteUSA 0.02341 0.02701 81.33591 0.867 0.38866
##
## (Intercept) ***
## mentalizing **
## siteUSA
## mentalizing:siteUSA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) mntlzn sitUSA
## mentalizing -0.098
## siteUSA -0.723 0.071
## mntlzng:USA 0.071 -0.729 -0.147
vals = seq(-4.5,4.5,.1)
predicted_h6m = ggeffects::ggpredict(mod_h6am, c("self_referential [vals]", "site")) %>%
data.frame() %>%
mutate(atlas = "self-referential") %>%
bind_rows(ggeffects::ggpredict(mod_h6bm, c("mentalizing [vals]", "site")) %>%
data.frame() %>%
mutate(atlas = "mentalizing")) %>%
mutate(atlas = factor(atlas, levels = c("self-referential", "mentalizing")))
predicted_sub_h6m = ggeffects::ggpredict(mod_h6am, terms = c("self_referential [vals]", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(roi = "self-referential") %>%
bind_rows(ggeffects::ggpredict(mod_h6bm, c("mentalizing [vals]", "site", "pID"), type = "random") %>%
data.frame() %>%
mutate(roi = "mentalizing")) %>%
mutate(roi = factor(roi, levels = c("self-referential", "mentalizing"))) %>%
filter((group == "Netherlands" & grepl("A", facet)) | (group == "USA" & !grepl("A", facet)))
predicted_h6m %>%
ggplot(aes(x = x, y = predicted, color = group, fill = group)) +
stat_smooth(data = predicted_sub_h6m, aes(group = interaction(group, facet)),
geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .3, color = NA) +
geom_line(size = 2) +
facet_grid(~atlas) +
scale_y_continuous(limits = c(1.5, 4), breaks = c(2:4)) +
scale_color_manual(name = "", values = palette_sample) +
scale_fill_manual(name = "", values = palette_sample) +
labs(y = "predicted sharing intention\n", x = "\nROI activity (SD)") +
plot_aes +
theme(legend.position = "top")table_h1am %>% mutate(DV = "H1a: Self-relevance") %>%
bind_rows(table_h1bm %>% mutate(DV = "H1b: Social relevance")) %>%
bind_rows(table_h2am %>% mutate(DV = "H2a: Self-relevance")) %>%
bind_rows(table_h2bm %>% mutate(DV = "H2b: Social relevance")) %>%
bind_rows(table_h3m %>% mutate(DV = "H3a-b: Sharing intention")) %>%
bind_rows(table_h4am %>% mutate(DV = "H4a: Self-referential ROI")) %>%
bind_rows(table_h4bm %>% mutate(DV = "H4b: Mentalizing ROI")) %>%
bind_rows(table_h5m %>% mutate(DV = "H5: Sharing intention")) %>%
bind_rows(table_h6am %>% mutate(DV = "H6a: Sharing intention")) %>%
bind_rows(table_h6bm %>% mutate(DV = "H6b: Sharing intention")) %>%
select(DV, everything()) %>%
kable() %>%
kable_styling()| DV | term | b [95% CI] | df | t | p |
|---|---|---|---|---|---|
| H1a: Self-relevance | intercept | 2.61 [2.50, 2.72] | 82.64 | 46.36 | < .001 |
| H1a: Self-relevance | self-referential | 0.04 [0.00, 0.08] | 84.47 | 2.23 | .028 |
| H1a: Self-relevance | sample (USA) | -0.09 [-0.25, 0.06] | 83.66 | -1.21 | .229 |
| H1a: Self-relevance | self-referential x sample (USA) | 0.01 [-0.04, 0.06] | 82.89 | 0.42 | .673 |
| H1b: Social relevance | intercept | 2.73 [2.61, 2.84] | 81.87 | 45.55 | < .001 |
| H1b: Social relevance | mentalizing | 0.04 [0.01, 0.08] | 83.25 | 2.42 | .018 |
| H1b: Social relevance | sample (USA) | -0.13 [-0.30, 0.03] | 83.42 | -1.61 | .111 |
| H1b: Social relevance | mentalizing x sample (USA) | 0.01 [-0.04, 0.06] | 82.63 | 0.29 | .772 |
| H2a: Self-relevance | intercept | 2.58 [2.46, 2.70] | 121.34 | 42.05 | < .001 |
| H2a: Self-relevance | other | 0.04 [-0.05, 0.12] | 5925.43 | 0.83 | .409 |
| H2a: Self-relevance | self | 0.04 [-0.05, 0.13] | 5925.22 | 0.89 | .372 |
| H2a: Self-relevance | sample (USA) | -0.05 [-0.22, 0.12] | 121.28 | -0.58 | .560 |
| H2a: Self-relevance | other x sample (USA) | -0.06 [-0.18, 0.06] | 5925.30 | -0.94 | .347 |
| H2a: Self-relevance | self x sample (USA) | -0.01 [-0.13, 0.11] | 5925.33 | -0.20 | .843 |
| H2b: Social relevance | intercept | 2.73 [2.60, 2.86] | 111.11 | 42.58 | < .001 |
| H2b: Social relevance | other | 0.02 [-0.06, 0.10] | 5925.36 | 0.39 | .694 |
| H2b: Social relevance | self | 0.00 [-0.08, 0.08] | 5925.20 | 0.00 | 1.000 |
| H2b: Social relevance | sample (USA) | -0.16 [-0.33, 0.02] | 111.07 | -1.81 | .074 |
| H2b: Social relevance | other x sample (USA) | 0.06 [-0.05, 0.17] | 5925.26 | 0.99 | .321 |
| H2b: Social relevance | self x sample (USA) | 0.09 [-0.02, 0.20] | 5925.28 | 1.52 | .128 |
| H3a-b: Sharing intention | intercept | 2.58 [2.50, 2.66] | 82.76 | 65.19 | < .001 |
| H3a-b: Sharing intention | self-relevance | 0.33 [0.27, 0.39] | 89.64 | 11.01 | < .001 |
| H3a-b: Sharing intention | sample (USA) | 0.10 [-0.01, 0.21] | 82.28 | 1.78 | .078 |
| H3a-b: Sharing intention | social relevance | 0.22 [0.15, 0.29] | 88.54 | 5.95 | < .001 |
| H3a-b: Sharing intention | self-relevance x sample (USA) | -0.03 [-0.11, 0.04] | 84.71 | -0.87 | .385 |
| H3a-b: Sharing intention | sample (USA) x social relevance | 0.04 [-0.06, 0.14] | 82.51 | 0.79 | .429 |
| H4a: Self-referential ROI | intercept | -0.14 [-0.29, 0.01] | 83.01 | -1.87 | .064 |
| H4a: Self-referential ROI | other | 0.10 [-0.01, 0.22] | 82.72 | 1.81 | .074 |
| H4a: Self-referential ROI | self | 0.08 [-0.05, 0.20] | 82.60 | 1.23 | .222 |
| H4a: Self-referential ROI | sample (USA) | 0.43 [0.22, 0.63] | 82.99 | 4.08 | < .001 |
| H4a: Self-referential ROI | other x sample (USA) | -0.03 [-0.19, 0.12] | 82.55 | -0.44 | .663 |
| H4a: Self-referential ROI | self x sample (USA) | 0.02 [-0.15, 0.19] | 82.68 | 0.24 | .814 |
| H4b: Mentalizing ROI | intercept | 0.12 [-0.03, 0.27] | 83.11 | 1.66 | .102 |
| H4b: Mentalizing ROI | other | 0.11 [0.00, 0.22] | 82.55 | 2.01 | .047 |
| H4b: Mentalizing ROI | self | 0.07 [-0.06, 0.19] | 82.65 | 1.10 | .276 |
| H4b: Mentalizing ROI | sample (USA) | 0.38 [0.18, 0.59] | 83.09 | 3.73 | < .001 |
| H4b: Mentalizing ROI | other x sample (USA) | -0.10 [-0.25, 0.05] | 82.37 | -1.27 | .208 |
| H4b: Mentalizing ROI | self x sample (USA) | 0.01 [-0.16, 0.18] | 82.73 | 0.11 | .915 |
| H5: Sharing intention | intercept | 2.61 [2.49, 2.73] | 124.80 | 43.00 | < .001 |
| H5: Sharing intention | other | -0.01 [-0.10, 0.08] | 5846.72 | -0.26 | .792 |
| H5: Sharing intention | self | -0.05 [-0.14, 0.04] | 5846.54 | -1.07 | .283 |
| H5: Sharing intention | sample (USA) | 0.06 [-0.11, 0.22] | 124.32 | 0.70 | .483 |
| H5: Sharing intention | other x sample (USA) | -0.04 [-0.16, 0.08] | 5846.55 | -0.63 | .528 |
| H5: Sharing intention | self x sample (USA) | 0.01 [-0.11, 0.13] | 5846.55 | 0.11 | .909 |
| H6a: Sharing intention | intercept | 2.60 [2.49, 2.71] | 82.89 | 46.74 | < .001 |
| H6a: Sharing intention | self-referential | 0.06 [0.02, 0.10] | 82.76 | 3.10 | .003 |
| H6a: Sharing intention | sample (USA) | 0.01 [-0.15, 0.16] | 83.88 | 0.09 | .928 |
| H6a: Sharing intention | self-referential x sample (USA) | 0.04 [-0.01, 0.09] | 81.13 | 1.51 | .135 |
| H6b: Sharing intention | intercept | 2.58 [2.47, 2.69] | 82.49 | 46.45 | < .001 |
| H6b: Sharing intention | mentalizing | 0.06 [0.02, 0.10] | 82.57 | 3.10 | .003 |
| H6b: Sharing intention | sample (USA) | 0.01 [-0.14, 0.17] | 84.55 | 0.17 | .865 |
| H6b: Sharing intention | mentalizing x sample (USA) | 0.02 [-0.03, 0.08] | 81.34 | 0.87 | .389 |
report::cite_packages()## - Angelo Canty and Brian Ripley (2021). boot: Bootstrap R (S-Plus) Functions. R package version 1.3-28.
## - Douglas Bates, Martin Maechler and Mikael Jagan (2023). Matrix: Sparse and Dense Matrix Classes and Methods. R package version 1.5-4. https://CRAN.R-project.org/package=Matrix
## - Douglas Bates, Martin Maechler, Ben Bolker, Steve Walker (2015). Fitting Linear Mixed-Effects Models Using lme4. Journal of Statistical Software, 67(1), 1-48. doi:10.18637/jss.v067.i01.
## - H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016.
## - Hadley Wickham (2021). forcats: Tools for Working with Categorical Variables (Factors). R package version 0.5.1. https://CRAN.R-project.org/package=forcats
## - Hadley Wickham (2022). stringr: Simple, Consistent Wrappers for Common String Operations. R package version 1.5.0. https://CRAN.R-project.org/package=stringr
## - Hadley Wickham and Maximilian Girlich (2022). tidyr: Tidy Messy Data. R package version 1.2.0. https://CRAN.R-project.org/package=tidyr
## - Hadley Wickham, Jennifer Bryan and Malcolm Barrett (2021). usethis: Automate Package and Project Setup. R package version 2.1.5. https://CRAN.R-project.org/package=usethis
## - Hadley Wickham, Jim Hester and Jennifer Bryan (2022). readr: Read Rectangular Text Data. R package version 2.1.2. https://CRAN.R-project.org/package=readr
## - Hadley Wickham, Jim Hester, Winston Chang and Jennifer Bryan (2021). devtools: Tools to Make Developing R Packages Easier. R package version 2.4.3. https://CRAN.R-project.org/package=devtools
## - Hadley Wickham, Romain François, Lionel Henry and Kirill Müller (2022). dplyr: A Grammar of Data Manipulation. R package version 1.0.9. https://CRAN.R-project.org/package=dplyr
## - Hao Zhu (2021). kableExtra: Construct Complex Table with 'kable' and Pipe Syntax. R package version 1.3.4. https://CRAN.R-project.org/package=kableExtra
## - Jim Hester, Hadley Wickham and Gábor Csárdi (2021). fs: Cross-Platform File System Operations Based on 'libuv'. R package version 1.5.2. https://CRAN.R-project.org/package=fs
## - Kirill Müller and Hadley Wickham (2022). tibble: Simple Data Frames. R package version 3.1.8. https://CRAN.R-project.org/package=tibble
## - Kuznetsova A, Brockhoff PB, Christensen RHB (2017). "lmerTest Package:Tests in Linear Mixed Effects Models." _Journal of StatisticalSoftware_, *82*(13), 1-26. doi: 10.18637/jss.v082.i13 (URL:https://doi.org/10.18637/jss.v082.i13).
## - Lionel Henry and Hadley Wickham (2020). purrr: Functional Programming Tools. R package version 0.3.4. https://CRAN.R-project.org/package=purrr
## - Lüdecke D (2018). "ggeffects: Tidy Data Frames of Marginal Effects fromRegression Models." _Journal of Open Source Software_, *3*(26), 772.doi: 10.21105/joss.00772 (URL: https://doi.org/10.21105/joss.00772).
## - R Core Team (2021). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
## - Rinker, T. W. & Kurkiewicz, D. (2017). pacman: Package Management for R. version 0.5.0. Buffalo, New York. http://github.com/trinker/pacman
## - Wickham et al., (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686, https://doi.org/10.21105/joss.01686
## - Yihui Xie (2021). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.37.
social relevance
❌ H2b: Other-focused intervention (compared to control) will increase social relevance
model table
summary